home *** CD-ROM | disk | FTP | other *** search
/ Amiga Collections: Purity / Purity #48 (1995-06-25)(PackMAN)(DE)[WB].zip / Purity #48 (1995-06-25)(PackMAN)(DE)[WB].adf / ShowIcon / showIcon1.p < prev    next >
Text File  |  1995-06-23  |  4KB  |  165 lines
  1. PROGRAM showicon;
  2. { Dieses Programm zeigt, wie man die Images der Icons auf dem eigenen
  3.  Screen darstellt und ist als Testprogramm für AddiPro entstanden, der
  4.  ultimativen FD-Adressverwaltung in Pascal auf dem Amiga ! Übrigens demnächst
  5.  Auf Purity, Aminet, ... }
  6.  
  7.   USES dos,gadtools,execsupport;
  8.   {$incl 'wb.lib','icon.lib'}
  9.   
  10.   VAR win   : p_window;
  11.       t     : Array[1..15] OF TagItem;
  12.       msg   : p_intuimessage;
  13.       ok    : BOOLEAN;
  14.       pscr  : p_screen;  
  15.       bh    : BYTE; {Barheight}
  16.     success : BOOLEAN;
  17.           i : INTEGER;
  18.        ende : BOOLEAN;
  19.    
  20. {fürs icon}
  21.  VAR dobj : p_DiskObject;
  22.       gad : Gadget;
  23.     gw,gh : INTEGER; { Gadgetwidth, Gadgetheight }
  24.     gr,sr : PTR;     { GadgetRender,Selectrender }
  25.     imptr : p_image; { Zeiger auf das Image }
  26.     
  27. { fürs appwindow }
  28.  CONST appname='ShowiconV0.1'
  29.        version='$VER:  Showicon V0.1 rev.0 14.06.95 19.17 UHR'
  30.   
  31.  VAR
  32.       appwin: p_appwindow;
  33.       apport: p_msgport;
  34.       appmsg: p_AppMessage;
  35.      winmask,mask,
  36.       appsig: LONG;
  37.       myarg : p_wbarg;
  38.       mydir : BPTR;
  39.    dir,name : STRING[256]
  40.  
  41.  
  42. { -- AppWindow-Port -- }
  43. PROCEDURE InitAppPort;
  44. BEGIN
  45.   Apport := CreateMsgPort;
  46.   IF Apport = NIL THEN
  47.   BEGIN
  48.    HALT(20);
  49.   END;
  50.   ApPort^.mp_Node.ln_Name := AppName;
  51.   ApPort^.mp_Node.ln_Pri  := 0;
  52.   ApPort^.mp_SigTask      := FindTask(NIL);
  53.   AddPort(Apport);
  54. END;
  55.  
  56. PROCEDURE DeleteAppPort;
  57. VAR
  58.   msg : p_Message;
  59. BEGIN
  60.   Forbid;
  61.   IF ApPort <> NIL THEN
  62.   BEGIN
  63.     msg := GetMsg(ApPort);
  64.     WHILE msg <> NIL DO
  65.     BEGIN
  66.       ReplyMsg(msg);
  67.       msg := GetMsg(ApPort);
  68.     END;
  69.     RemPort(ApPort);
  70.     DeleteMsgPort(ApPort);
  71.   END;
  72.   ApPort := NIL;
  73.   Permit;
  74. END;
  75.  
  76. PROCEDURE dobjkram;
  77.  BEGIN
  78.   IF name[length(name)]='/' THEN name[length(name)]:=CHR(0); {für Verzeichnisse!}
  79.   dobj:= GetDiskObjectNew(name);
  80.   gad:=dobj^.do_gadget;
  81.   imptr:=p_image(gad.GadgetRender); { das 1. image holen. Der Zeiger muß gewandelt werden! }
  82.   DrawImage(win^.rport,imptr,win^.borderleft,bh+1); {in die linke obere Ecke zeichnen}
  83.   freediskobject(dobj);                             { freigeben nicht vergessen }
  84.   setwindowtitles(win,name,ptr(-1));                {Iconname ausgeben}
  85.  END;
  86.   
  87.   
  88. PROCEDURE openlibs;
  89.  BEGIN
  90.   OpenLib(WorkbenchBase, "workbench.library", 37);
  91.   OpenLib(IconBase,"icon.library",0);
  92.  END;
  93.   
  94.  BEGIN
  95.   openlibs;
  96.   ende:=FALSE;
  97.   pscr:=lockpubScreen('Workbench');
  98.   bh:=pscr^.barheight;
  99.   initappPort;
  100.   unLockPubScreen(NIL,pscr);
  101.  
  102.   t[1]:=TagItem(WA_InnerWidth,200);
  103.   t[2]:=TagItem(WA_InnerHeight,100);
  104.   t[3].ti_Tag:=WA_Title;
  105.   t[3].ti_data:='Showicon1 (c) 14.06.95 by Røgersøft';
  106.   t[4]:=TagItem(WA_Idcmp,IDCMP_CLOSEWINDOW);
  107.   t[5]:=TagItem(WA_Flags,WFLG_CLOSEGADGET+WFLG_DRAGBAR+WFLG_ACTIVATE+
  108.                 WFLG_DEPTHGADGET+WFLG_SMART_REFRESH+WFLG_NOCAREREFRESH);
  109.   t[6]:=TagItem(WA_Left,50); 
  110.   t[7]:=TagItem(WA_Top,25);
  111.   t[8].ti_Tag:=TAG_DONE;
  112.   win:=OpenWindowTaglist(NIL,^t);
  113.   IF win=NIL THEN exit;
  114.   GT_Refreshwindow(Win,NIL);
  115.  
  116.   Appwin:=AddAppwindowA(1,0,win,Apport,NIL);
  117.   IF AppWin=NIL THEN
  118.    BEGIN
  119.     Closewindow(win);
  120.     HALT(20); 
  121.    END;
  122.   winmask:=LONG(1) SHL LONG(win^.Userport^.mp_SigBit);
  123.   AppSig:=LONG(1) SHL LONG(Apport^.mp_SigBIt);
  124.  
  125.   REPEAT   
  126.    mask:=_wait(winmask OR Appsig);
  127.    IF (mask AND appsig)=AppSig THEN
  128.     BEGIN
  129.      appmsg:=p_AppMessage(GetMsg(Apport));
  130.      WHILE (appmsg<>NIL) DO
  131.      BEGIN
  132.       IF (appmsg^.am_Type=MTYPE_APPWINDOW) THEN
  133.        BEGIN
  134.         myarg:=appmsg^.am_arglist;
  135.         name:=myarg^.wa_name;
  136.         mydir:=myarg^.wa_lock;
  137.         i:=NameFromLock(mydir,^dir,255);
  138.         IF dir[length(dir)]<>':' THEN dir:=dir+'/';
  139.         name:=dir+name;
  140.         dobjkram;
  141.        END;
  142.      Replymsg(p_message(appmsg));
  143.      appmsg:=p_appmessage(GetMsg(apport));
  144.      END;  { Of WHILE }
  145.     END;   
  146.   IF (mask AND winmask) = winmask THEN
  147.    BEGIN
  148.    msg:=GT_getImsg(win^.userport);
  149.    WHILE msg<>NIL DO
  150.    BEGIN
  151.     GT_ReplyImsg(msg);
  152.     CASE msg^.Class OF
  153.  
  154.      IDCMP_CLOSEWINDOW: ende:=TRUE;
  155.    
  156.      ELSE END; {OF CASE }
  157.      msg:=GT_GetImsg(win^.Userport);
  158.     END; 
  159.    END;
  160.   UNTIL ende;
  161.   ok:=RemoveAppwindow(appwin); 
  162.   DeleteAppPort;
  163.   Closewindow(win);
  164.  END.  
  165.